home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 26
/
Cream of the Crop 26.iso
/
program
/
qbsnip.zip
/
SHADETXT.BAS
< prev
next >
Wrap
BASIC Source File
|
1997-06-20
|
3KB
|
148 lines
DEFINT A-Z
DECLARE SUB ShadeText (message$, x%, y%, way%)
'Not-so-fancy shaded text
'
'This is another cool way to shade your screen mode 13 text!
'
'3/2/1997 By: - Nick Kochakian -
'
'If you have any comments or questions please e-mail me at:
'nickK@worldnet.att.net
'
'Have fun! :)
' Modified by Tika Carr (t.carr@pobox.com) on June 20, 1997
' o Fixed text locate bug
' o Renamed function to ShadeText
' o Made all verables integers (not that it mattered :)
' o Wrote a "panning effect" demo to show off a way this routine could
' be used
' o Changed SUB to use SELECT CASE
DEFINT A-Z
SCREEN 13
'Make shure message$ is longer than one character!
message$ = "Just another way to shade text!" 'The message to display
x = 5
y = 12
'Ways to shade:
'way = 1 -> Dark ooze text (Works great with a palette cycling routine!)
'way = 2 -> Brighter ooze text
'way = 3 -> "Light source" right
'way = 4 -> The opposite of way = 3
'way = 5 -> "Light source" is centered
DO
ShadeText message$, x, y, 3: SLEEP 1
ShadeText message$, x, y, 5: SLEEP 1
ShadeText message$, x, y, 4: SLEEP 1
ShadeText message$, x, y, 5: SLEEP 1
LOOP UNTIL INKEY$ <> ""
SCREEN 0, 0, 0, 0: WIDTH 80: COLOR 7, 0: CLS : END
SUB ShadeText (message$, x%, y%, way%)
cntr = 1
col = 16
cntrr = 1
msglen = LEN(message$)
LOCATE y, x
SELECT CASE way
CASE 1:
DO
COLOR col
PRINT MID$(message$, cntr, 1);
cntr = cntr + 1
col = col + 1
IF col > 30 THEN col = 16
LOOP UNTIL cntr = msglen
CASE 2:
col = 20
DO
COLOR col
PRINT MID$(message$, cntr, 1);
cntr = cntr + 1
col = col + 1
IF col > 30 THEN col = 20
LOOP UNTIL cntr = msglen
CASE 3:
col = 20
DO
COLOR col
PRINT MID$(message$, cntr, 1);
cntr = cntr + 1
col = col + 1
LOOP UNTIL cntr = msglen OR col > 30
IF cntr = msglen THEN EXIT SUB
DO
col = col - 1
PRINT MID$(message$, cntr, 1);
cntr = cntr + 1
LOOP UNTIL col < 21 OR cntr = msglen
IF cntr = msglen THEN EXIT SUB
DO
PRINT MID$(message$, cntr, 1);
cntr = cntr + 1
LOOP UNTIL cntr = msglen
CASE 4:
col = 30
DO
COLOR col
PRINT MID$(message$, cntr, 1);
cntr = cntr + 1
col = col - 1
LOOP UNTIL cntr = msglen OR col < 21
IF cntr = msglen THEN EXIT SUB
DO
col = col + 1
PRINT MID$(message$, cntr, 1);
cntr = cntr + 1
LOOP UNTIL col > 30 OR cntr = msglen
IF cntr = msglen THEN EXIT SUB
DO
PRINT MID$(message$, cntr, 1);
cntr = cntr + 1
LOOP UNTIL cntr = msglen
CASE 5:
col = 20
DO
COLOR col
PRINT MID$(message$, cntr, 1);
cntr = cntr + 1
col = col + 1
LOOP UNTIL cntr = msglen OR col > 30
IF cntr = msglen THEN EXIT SUB
DO
COLOR col
PRINT MID$(message$, cntr, 1);
cntr = cntr + 1
col = col - 1
LOOP UNTIL col < 21 OR cntr = msglen
IF cntr = msglen THEN EXIT SUB
DO
PRINT MID$(message$, cntr, 1);
cntr = cntr + 1
LOOP UNTIL cntr = msglen
END SELECT
END SUB